Initial Set Up Steps

library(shinydashboard)
library(tidyverse)
library(leaflet)
library(shiny)
library(sf)
library(htmlwidgets)
library(googlesheets4)
library(RColorBrewer)
library(lubridate)
library(purrr)

library(censusapi)
library(rgeos)
library(tidycensus)
library(tigris)
library(usmap)

library(colorspace)
library(ggplot2)
library(reshape2)
library(formattable)

Sys.setenv(CENSUS_KEY="c8aa67e4086b4b5ce3a8717f59faa9a28f611dab")
github_directory <- "https://raw.githubusercontent.com/stanfordfuturebay/stanfordfuturebay.github.io/master/data/"
github_rds <- "https://github.com/stanfordfuturebay/stanfordfuturebay.github.io/blob/master/data/"

options(
  tigris_class = "sf",
  tigris_use_cache = TRUE
)

mapbox_sat <- "https://api.mapbox.com/styles/v1/samanyl/ck9hpl0sm0fuq1ip8yfb2yrn8/tiles/256/{z}/{x}/{y}@2x?access_token=pk.eyJ1Ijoic2FtYW55bCIsImEiOiJjazlocGNvYWgxMHhxM2Rud2pxdzVnMnp2In0.D_j3K9tXiEddHH-8UUkeZQ"
mapbox_satAtt <- "© <a href='https://www.mapbox.com/map-feedback/'>Mapbox</a> Satellite Map"

bay_county_names <-
  c(
    "Alameda",
    "Contra Costa",
    "Marin",
    "Napa",
    "San Francisco",
    "San Mateo",
    "Santa Clara",
    "Solano",
    "Sonoma"
  )

bay_counties <- readRDS(gzcon(url(paste0(github_rds,"bay_counties.rds?raw=true"))))

setwd("C:/Users/liusa/github/covid19/snap project/sam")


# bay_counties <-
#   counties("CA", cb = F, progress_bar=F) %>%
#   filter(NAME %in% bay_county_names)
#
# zctas <-
#   zctas(cb=F)
#
# bay_zctas <-
#   zctas %>%
#   dplyr::select(ZCTA5CE10) %>%
#   st_join(bay_counties %>% dplyr::select(geometry),left=F)
#
# saveRDS(bay_zctas, file = "bay_zctas.rds")
sheets_deauth()

retailers <-
  read_sheet("1tvMBCWNeh7kyyKklntmWfV1zNJx8bN-KxHIYmaULZxg")

retailers$long <- as.numeric(retailers$long)
retailers$lat <- as.numeric(retailers$lat)

snap <- retailers %>% filter(type == "SNAP_accepting_retailer")
wic <- retailers %>% filter(type == "WIC_only_store")
snap_wic <- retailers %>% filter(type == "WIC_SNAP_retailer")
snap_restaurant <- retailers %>% filter(type=="SNAP_restaurant")
snap_farmers <- retailers %>% filter(type=="SNAP_farmers_market")

snap_curbside <- snap %>% filter(!is.na(curbside_pickup))
wic_curbside <- wic %>% filter(!is.na(curbside_pickup))
snapwic_curbside <- snap_wic %>% filter(!is.na(curbside_pickup))
snaprest_curbside <- snap_restaurant %>% filter(!is.na(curbside_pickup))
snapfarm_curbside <- snap_farmers %>% filter(!is.na(curbside_pickup))

snap_delivery <- snap %>% filter(!is.na(delivery))
wic_delivery <- wic %>% filter(!is.na(delivery))
snapwic_delivery <- snap_wic %>% filter(!is.na(delivery))
snaprest_delivery <- snap_restaurant %>% filter(!is.na(delivery))
snapfarm_delivery <- snap_farmers %>% filter(!is.na(delivery))

snap_senior <- snap %>% filter(!is.na(senior_hours))
wic_senior <- wic %>% filter(!is.na(senior_hours))
snapwic_senior <- snap_wic %>% filter(!is.na(senior_hours))
snaprest_senior <- snap_restaurant %>% filter(!is.na(senior_hours))
snapfarm_senior <- snap_farmers %>% filter(!is.na(senior_hours))

snapIcon <- makeIcon(
  iconUrl = "baymap/bag.png",
  iconWidth=25,iconHeight=25)

wicIcon <- makeIcon(
  iconUrl = "baymap/love.png",
  iconWidth=30,iconHeight=30)

snapwicIcon <- makeIcon(
  iconUrl = "baymap/snapwic.png",
  iconWidth=30,iconHeight=30)

snaprestIcon <- makeIcon(
  iconUrl = "baymap/cutlery.png",
  iconWidth=25,iconHeight=25)

snapfarmIcon <- makeIcon(
  iconUrl = "baymap/chicken.png",
  iconWidth=25,iconHeight=25)

homeIcon <- makeIcon(
  iconUrl = "baymap/internet.png",
  iconWidth=25,iconHeight=25)

html_legend <- "<img src='https://raw.githubusercontent.com/stanfordfuturebay/stanfordfuturebay.github.io/master/data/bag.png' height='30' width='30'> SNAP Only Retailers<br/><img src='https://raw.githubusercontent.com/stanfordfuturebay/stanfordfuturebay.github.io/master/data/love.png' height='30' width='30'> WIC Only Retailers<br/><img src='https://raw.githubusercontent.com/stanfordfuturebay/stanfordfuturebay.github.io/master/data/snapwic.png' height='30' width='30'> SNAP and WIC Accepting Retailers<br/><img src='https://raw.githubusercontent.com/stanfordfuturebay/stanfordfuturebay.github.io/master/data/money.png' height='30' width='30'> Cash EBT Withdrawal Locations<br/><img src='https://raw.githubusercontent.com/stanfordfuturebay/stanfordfuturebay.github.io/master/data/cutlery.png' height='30' width='30'> SNAP Accepting Restaurants<br/><img src='https://raw.githubusercontent.com/stanfordfuturebay/stanfordfuturebay.github.io/master/data/chicken.png' height='30' width='30'> SNAP Accepting Farmers Markets"

cluster <-
  markerClusterOptions(
    showCoverageOnHover=F,
    spiderfyOnMaxZoom=F,
    disableClusteringAtZoom=14
    )

# time format --> format(dataset$____, %I:%M%p)

pop <- function(dataset){
  result <-
    paste0(
      ifelse(
        is.na(dataset$web_link),
        paste0("<strong>",dataset$site_name,"</strong><br>"),
        paste0("<a href='",dataset$web_link,"' target='_blank'><strong>",dataset$site_name,"</strong></a><br>")
      ),
      dataset$address, "<br>",
      dataset$city,", ",
      dataset$state," ",
      dataset$zip,
      "<br><br><img src='https://raw.githubusercontent.com/stanfordfuturebay/stanfordfuturebay.github.io/master/data/pin.png' height='12'>
      <a href='https://www.google.com/maps/dir/?api=1&destination=",
      dataset$lat,",",
      dataset$long,"' target='_blank'>Directions To Here</a>",
      '<br><br><strong>Hours of Operation: </strong><br>',
      dataset$days_hours_line1,
      ifelse(
        is.na(dataset$days_hours_line2),
        "",
        paste0("<br>",dataset$days_hours_line2)
      ),
      ifelse(
        is.na(dataset$days_hours_line3),
        "",
        paste0("<br>",dataset$days_hours_line3)
      ),
      ifelse(
        is.na(dataset$days_hours_line4),
        "",
        paste0("<br>",dataset$days_hours_line4)
      ),
      "<br><br><strong>Contact Information:</strong><br>",
      ifelse(
        is.na(dataset$facebook),
        "",
        paste0("<a href='",dataset$facebook,"' target='_blank'>Facebook</a><br>")
      ),
      dataset$phone,"<br>",
      ifelse(
        is.na(dataset$notes),
        "",
        paste0("<br><strong>Notes: </strong>",dataset$notes,"<br>")
      ),
      ifelse(
        is.na(dataset$senior_hours),
        "",
        paste0(
          '<br><strong style="color:red">** SPECIAL SENIOR HOURS ** </strong><br>',
          dataset$senior_hours)
      )
    )
  return(result)
}
bay_zctas <- readRDS("P:/Stanford/Classes/CEE218Z - Shaping the Future of the Bay/bay_zctas.rds")

wd <- "P:/Shared/SFBI/Restricted Data Library/Safegraph/covid19analysis/transactions-facteus/"

combining <- function(pattern) {
  files <- list.files(pattern = pattern)
  return(do.call(rbind, lapply(files,readRDS)))
}

spending_total <- readRDS(paste0(wd,"cut-1-daily-spend-by-zip/2020-04-22/cut-1-daily-spend-by-zip-20170101-20200417-bay.rds"))

setwd(paste0(wd,"cut-2-daily-spend-by-zip-by-mcc/2020-04-22"))
spending_MCC <-
  combining("cut-2-daily-spend-by-zip-by-mcc-20170101-20200417-[0-1][0-9]-bay.rds")

setwd(paste0(wd,"cut-3-daily-spend-by-brand/2020-04-22"))
spending_brand <- combining("daily-spend-by-brand-20170101-20200417-[0-1][0-9]-bay.rds")

walmart_instore <- readRDS(paste0(wd,"cut-4-daily-spend-at-walmart/2020-04-22/daily-spend-by-zip-walmart-instore-20170101-20200417-bay.rds"))

walmart_online <- readRDS(paste0(wd,"cut-4-daily-spend-at-walmart/2020-04-22/daily-spend-by-zip-walmart-online-20170101-20200417-bay.rds"))

setwd("C:/Users/liusa/github/covid19/snap project/sam")

Leaflet Snap Circle Icons

cols <- brewer.pal(5, name='Set1')
retail.col <- colorFactor(cols, domain = c("SNAP_accepting_retailer","WIC_only_store","WIC_SNAP_retailer","SNAP_restaurant",
                                           "SNAP_farmers_market"))

mpc <- leaflet() %>%
    addProviderTiles(providers$CartoDB.VoyagerLabelsUnder, group = "Default") %>%
    addTiles(urlTemplate = mapbox_sat, attribution = mapbox_satAtt, group = "Satellite") %>%
    addCircleMarkers(
      lng = retailers$long,
      lat = retailers$lat,
      clusterOptions = cluster,
      color = retail.col(retailers$type),
      radius = 5,
      popup = pop(retailers)
      ) %>%
    addLegend(
      position = 'bottomleft',
      values = subset(retailers$type,!is.na(retailers$type)),
      na.label = "",
      pal = retail.col,
      title='Stores'
      ) %>%
    addLayersControl(
      baseGroups = c("Default","Satellite")
      )

mpc

Leaflet Snap with Flat Icons

mpi <- leaflet() %>%
    addProviderTiles(providers$CartoDB.VoyagerLabelsUnder, group = "Default") %>%
    # addProviderTiles(providers$CartoDB.Positron, group = "Positron") %>% # add mapbox
    addTiles(urlTemplate = mapbox_sat, attribution = mapbox_satAtt, group = "Satellite") %>%
    addMarkers(
      lng = snap$long,
      lat = snap$lat,
      clusterOptions = cluster,
      popup = pop(snap),
      icon = snapIcon,
      group = "SNAP Only Retailers"
      ) %>%
    addMarkers(
      lng = wic$long,
      lat = wic$lat,
      clusterOptions = cluster,
      popup = pop(wic),
      icon = wicIcon,
      group = "WIC Only Retailers"
      ) %>%
    addMarkers(
      lng = snap_wic$long,
      lat = snap_wic$lat,
      clusterOptions = cluster,
      popup = pop(snap_wic),
      icon = snapwicIcon,
      group = "SNAP and WIC Accepting Retailers"
      ) %>%
    addMarkers(
      lng = snap_restaurant$long,
      lat = snap_restaurant$lat,
      clusterOptions = cluster,
      popup = pop(snap_restaurant),
      icon = snaprestIcon,
      group = "SNAP Accepting Restaurants"
      ) %>%
    addMarkers(
      lng = snap_farmers$long,
      lat = snap_farmers$lat,
      clusterOptions = cluster,
      popup = pop(snap_farmers),
      icon = snapfarmIcon,
      group = "SNAP Accepting Farmers Markets"
      ) %>%
    addMarkers(
      lng = snap_curbside$long,
      lat = snap_curbside$lat,
      clusterOptions = cluster,
      popup = pop(snap_curbside),
      icon = snapIcon,
      group = "Offers Curbside Pick-up"
      ) %>%
    addMarkers(
      lng = wic_curbside$long,
      lat = wic_curbside$lat,
      clusterOptions = cluster,
      popup = pop(wic_curbside),
      icon = wicIcon,
      group = "Offers Curbside Pick-up"
      ) %>%
    addMarkers(
      lng = snapwic_curbside$long,
      lat = snapwic_curbside$lat,
      clusterOptions = cluster,
      popup = pop(snapwic_curbside),
      icon = snapwicIcon,
      group = "Offers Curbside Pick-up"
      ) %>%
    addMarkers(
      lng = snaprest_curbside$long,
      lat = snaprest_curbside$lat,
      clusterOptions = cluster,
      popup = pop(snaprest_curbside),
      icon = snaprestIcon,
      group = "Offers Curbside Pick-up"
      ) %>%
    addMarkers(
      lng = snapfarm_curbside$long,
      lat = snapfarm_curbside$lat,
      clusterOptions = cluster,
      popup = pop(snapfarm_curbside),
      icon = snapfarmIcon,
      group = "Offers Curbside Pick-up"
      ) %>%
    addMarkers(
      lng = snap_delivery$long,
      lat = snap_delivery$lat,
      clusterOptions = cluster,
      popup = pop(snap_delivery),
      icon = snapIcon,
      group = "Offers CSA Box Delivery"
      ) %>%
    addMarkers(
      lng = wic_delivery$long,
      lat = wic_delivery$lat,
      clusterOptions = cluster,
      popup = pop(wic_delivery),
      icon = wicIcon,
      group = "Offers CSA Box Delivery"
      ) %>%
    addMarkers(
      lng = snapwic_delivery$long,
      lat = snapwic_delivery$lat,
      clusterOptions = cluster,
      popup = pop(snapwic_delivery),
      icon = snapwicIcon,
      group = "Offers CSA Box Delivery"
      ) %>%
    addMarkers(
      lng = snaprest_delivery$long,
      lat = snaprest_delivery$lat,
      clusterOptions = cluster,
      popup = pop(snaprest_delivery),
      icon = snaprestIcon,
      group = "Offers CSA Box Delivery"
      ) %>%
    addMarkers(
      lng = snapfarm_delivery$long,
      lat = snapfarm_delivery$lat,
      clusterOptions = cluster,
      popup = pop(snapfarm_delivery),
      icon = snapfarmIcon,
      group = "Offers CSA Box Delivery"
      ) %>%
    addMarkers(
      lng = snap_senior$long,
      lat = snap_senior$lat,
      clusterOptions = cluster,
      popup = pop(snap_senior),
      icon = snapIcon,
      group = "Offers Senior Hours"
      ) %>%
    addMarkers(
      lng = wic_senior$long,
      lat = wic_senior$lat,
      clusterOptions = cluster,
      popup = pop(wic_senior),
      icon = wicIcon,
      group = "Offers CSA Box Delivery"
      ) %>%
    addMarkers(
      lng = snapwic_senior$long,
      lat = snapwic_senior$lat,
      clusterOptions = cluster,
      popup = pop(snapwic_senior),
      icon = snapwicIcon,
      group = "Offers CSA Box Delivery"
      ) %>%
    addMarkers(
      lng = snaprest_senior$long,
      lat = snaprest_senior$lat,
      clusterOptions = cluster,
      popup = pop(snaprest_senior),
      icon = snaprestIcon,
      group = "Offers CSA Box Delivery"
      ) %>%
    addMarkers(
      lng = snapfarm_senior$long,
      lat = snapfarm_senior$lat,
      clusterOptions = cluster,
      popup = pop(snapfarm_senior),
      icon = snapfarmIcon,
      group = "Offers CSA Box Delivery"
      ) %>%
    addLayersControl(
      baseGroups = c("Default","Mapbox Basemap","Satellite"),
      overlayGroups = c("SNAP Only Retailers","WIC Only Retailers","SNAP and WIC Accepting Retailers","Cash EBT Withdrawal Locations",
                        "SNAP Accepting Restaurants","SNAP Accepting Farmers Markets")
      ) %>%
    addControl(
      html=html_legend,
      position="bottomleft") %>%
  hideGroup(c("Offers Curbside Pick-up", "Offers CSA Box Delivery","Offers Senior Hours"))

mpi

Walmart vs. SNAP Demographics

# # most popular/accessible walmart among zipcodes (plot number of transactions on map)
# spending_brand_sum <-
#   spending_brand %>%
#   group_by(merchant,zip) %>%
#   filter(merchant=="WALMART") %>%
#   summarize(
#     mean=mean(as.numeric(total_spent)),
#     sum=sum(as.numeric(total_spent)),
#     transactions_sum=sum(as.numeric(transaction_counts)),
#     transactions_avg=mean(as.numeric(transaction_counts))) %>%
#   left_join(bay_zctas,by=c("zip"="ZCTA5CE10")) %>%
#   distinct(zip,.keep_all = T) %>%
#   st_as_sf(dim = "XY", sf_column_name = "geometry") %>%
#   st_transform(crs=4326)
#
# spending_brand_sum <- spending_brand_sum[order(spending_brand_sum$transactions_avg),]

## normalize based on population

spending_brand_sum <- readRDS("baymap/spending_brand_sum.rds")

spending_brand_sum_top5 <- tail(spending_brand_sum,5)
spending_brand_sum_top10 <- tail(spending_brand_sum,10)

# saveRDS(spending_brand_sum,"spending_brand_sum.rds")

pal <- sequential_hcl("red-blue",n=3,rev=T)
col <- colorNumeric(pal,domain=spending_brand_sum$transactions_avg)


fp <- leaflet() %>%
    addProviderTiles(providers$CartoDB.VoyagerLabelsUnder, group = "Default") %>%
    addTiles(urlTemplate = mapbox_sat, attribution = mapbox_satAtt, group = "Satellite") %>%
    addPolygons(
      data = spending_brand_sum,
      color = col(spending_brand_sum$transactions_avg),
      weight=1,
      popup = paste0(
        "<strong>",spending_brand_sum$zip,"</strong><br>",
        spending_brand_sum$transactions_avg),
      labelOptions = labelOptions(
        style = list("font-weight" = "normal", padding = "3px 8px"),
        textsize = "15px",
        direction = "auto"),
      group = "All"
      ) %>%
    addPolygons(
      data = spending_brand_sum_top5,
      weight=2,
      color = "red",
      popup = paste0(
        "<strong>",spending_brand_sum_top5$zip,"</strong><br>",
        spending_brand_sum_top5$transactions_avg),
      labelOptions = labelOptions(
        style = list("font-weight" = "normal", padding = "3px 8px"),
        textsize = "15px",
        direction = "auto"),
      group = "Top 5"
      ) %>%
    addPolygons(
      data = spending_brand_sum_top10,
      color = "red",
      weight=2,
      popup = paste0(
        "<strong>",spending_brand_sum_top10$zip,"</strong><br>",
        spending_brand_sum_top10$transactions_avg),
      labelOptions = labelOptions(
        style = list("font-weight" = "normal", padding = "3px 8px"),
        textsize = "15px",
        direction = "auto"),
      group = "Top 10"
      ) %>%
    addLegend(
      position = 'bottomleft',
      values = spending_brand_sum$transactions_avg,
      pal = col,
      title='Avg Daily Walmart Transactions'
      ) %>%
    addLayersControl(
      baseGroups = c("Default","Satellite"),
      overlayGroups = c("All","Top 5","Top 10")
    ) %>%
  hideGroup(c("Top 5","Top 10"))

fp

Shiny App Implementation